home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / turbtool.arc / CHAPTER5.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-04-01  |  8.5 KB  |  415 lines
  1. {$A-}
  2. PROGRAM CHAPTER5;
  3. {$I TOOLU.PAS}
  4. CONST
  5.   MAXPAT=MAXSTR;
  6.   CLOSIZE=1;
  7.   CLOSURE=STAR;
  8.   BOL=PERCENT;
  9.   EOL=DOLLAR;
  10.   ANY=QUESTION;
  11.   CCL=LBRACK;
  12.   CCLEND=RBRACK;
  13.   NEGATE=CARET;
  14.   NCCL=EXCLAM;
  15.   LITCHAR=67;
  16.  
  17. var cmdptr:file;
  18. FUNCTION MAKEPAT (VAR ARG:XSTRING; START:INTEGER;
  19.   DELIM:CHARACTER; VAR PAT:XSTRING):INTEGER;FORWARD;
  20.   
  21. FUNCTION AMATCH(VAR LIN:XSTRING;OFFSET:INTEGER;
  22.   VAR PAT:XSTRING; J:INTEGER):INTEGER;FORWARD;
  23. FUNCTION MATCH(VAR LIN,PAT:XSTRING):BOOLEAN;FORWARD;
  24.  
  25. FUNCTION MAKEPAT;
  26. VAR
  27.   I,J,LASTJ,LJ:INTEGER;
  28.   DONE,JUNK:BOOLEAN;
  29.  
  30. FUNCTION GETCCL(VAR ARG:XSTRING; VAR I:INTEGER;
  31.   VAR PAT:XSTRING; VAR J:INTEGER):BOOLEAN;
  32. VAR
  33.   JSTART:INTEGER;
  34.   JUNK:BOOLEAN;
  35.  
  36. PROCEDURE DODASH(DELIM:CHARACTER; VAR SRC:XSTRING;
  37.   VAR I:INTEGER; VAR DEST:XSTRING;
  38.   VAR J:INTEGER; MAXSET:INTEGER);
  39. CONST ESCAPE=ATSIGN;
  40. VAR K:INTEGER;
  41. JUNK:BOOLEAN;
  42.  
  43. FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
  44. BEGIN
  45.   IF(S[I]<>ESCAPE) THEN
  46.     ESC:=S[I]
  47.   ELSE IF (S[I+1]=ENDSTR) THEN
  48.     ESC:=ESCAPE
  49.   ELSE BEGIN
  50.     I:=I+1;
  51.     IF (S[I]=ORD('N')) THEN
  52.       ESC:=NEWLINE
  53.     ELSE IF (S[I]=ORD('T')) THEN
  54.       ESC:=TAB
  55.     ELSE
  56.       ESC:=S[I]
  57.     END
  58. END;
  59.  
  60. BEGIN
  61.   WHILE(SRC[I]<>DELIM) AND (SRC[I]<>ENDSTR) DO BEGIN
  62.     IF(SRC[I]=ESCAPE)THEN
  63.       JUNK:=ADDSTR(ESC(SRC,I),DEST,J,MAXSET)
  64.     ELSE IF (SRC[I]<>DASH) THEN
  65.       JUNK:=ADDSTR(SRC[I],DEST,J,MAXSET)
  66.     ELSE IF (J<=1) OR (SRC[I+1]=ENDSTR) THEN
  67.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET)
  68.     ELSE IF (ISALPHANUM(SRC[I-1]))
  69.       AND (ISALPHANUM(SRC[I+1]))
  70.       AND (SRC[I-1]<=SRC[I+1]) THEN BEGIN
  71.         FOR K:=SRC[I-1]+1 TO SRC[I+1] DO
  72.           JUNK:=ADDSTR(K,DEST,J,MAXSET);
  73.             I:=I+1
  74.     END
  75.     ELSE
  76.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET);
  77.     I:=I+1
  78.   END
  79. END;
  80.  
  81. BEGIN
  82.   I:=I+1;
  83.   IF(ARG[I]=NEGATE) THEN BEGIN
  84.     JUNK:=ADDSTR(NCCL,PAT,J,MAXPAT);
  85.     I:=I+1
  86.   END
  87.   ELSE
  88.     JUNK:=ADDSTR(CCL,PAT,J,MAXPAT);
  89.   JSTART:=J;
  90.   JUNK:=ADDSTR(0,PAT,J,MAXPAT);
  91.   DODASH(CCLEND,ARG,I,PAT,J,MAXPAT);
  92.   PAT[JSTART]:=J-JSTART-1;
  93.   GETCCL:=(ARG[I]=CCLEND)
  94. END;
  95.  
  96. PROCEDURE STCLOSE(VAR PAT:XSTRING;VAR J:INTEGER;
  97.   LASTJ:INTEGER);
  98. VAR
  99.   JP,JT:INTEGER;
  100.   JUNK:BOOLEAN;
  101. BEGIN
  102.   FOR JP:=J-1 DOWNTO LASTJ DO BEGIN
  103.     JT:=JP+CLOSIZE;
  104.     JUNK:=ADDSTR(PAT[JP],PAT,JT,MAXPAT)
  105.   END;
  106.   J:=J+CLOSIZE;
  107.   PAT[LASTJ]:=CLOSURE
  108. END;
  109.  
  110. BEGIN
  111.   J:=1;
  112.   I:=START;
  113.   LASTJ:=1;
  114.   DONE:=FALSE;
  115.   WHILE(NOT DONE) AND (ARG[I]<>DELIM)
  116.     AND (ARG[I]<>ENDSTR) DO BEGIN
  117.       LJ:=J;
  118.       IF(ARG[I]=ANY) THEN
  119.         JUNK:=ADDSTR(ANY,PAT,J,MAXPAT)
  120.       ELSE IF (ARG[I]=BOL) AND (I=START) THEN
  121.         JUNK:=ADDSTR(BOL,PAT,J,MAXPAT)
  122.       ELSE IF (ARG[I]=EOL) AND (ARG[I+1]=DELIM) THEN
  123.         JUNK:=ADDSTR(EOL,PAT,J,MAXPAT)
  124.       ELSE IF (ARG[I]=CCL) THEN
  125.         DONE:=(GETCCL(ARG,I,PAT,J)=FALSE)
  126.       ELSE IF (ARG[I]=CLOSURE) AND (I>START) THEN BEGIN
  127.         LJ:=LASTJ;
  128.         IF(PAT[LJ] IN [BOL,EOL,CLOSURE]) THEN
  129.           DONE:=TRUE
  130.         ELSE
  131.           STCLOSE(PAT,J,LASTJ)
  132.       END
  133.       ELSE BEGIN
  134.         JUNK:=ADDSTR(LITCHAR,PAT,J,MAXPAT);
  135.         JUNK:=ADDSTR(ESC(ARG,I),PAT,J,MAXPAT)
  136.       END;
  137.       LASTJ:=LJ;
  138.       IF(NOT DONE) THEN
  139.         I:=I+1
  140.     END;
  141.     IF(DONE) OR (ARG[I]<>DELIM) THEN
  142.       MAKEPAT:=0
  143.     ELSE IF (NOT ADDSTR(ENDSTR,PAT,J,MAXPAT)) THEN
  144.       MAKEPAT:=0
  145.     ELSE
  146.       MAKEPAT:=I
  147.   END;
  148.   
  149.  
  150. FUNCTION AMATCH;
  151.  
  152.  
  153. VAR I,K:INTEGER;
  154.    DONE:BOOLEAN;
  155.  
  156.  
  157. FUNCTION OMATCH(VAR LIN:XSTRING; VAR I:INTEGER;
  158.   VAR PAT:XSTRING; J:INTEGER):BOOLEAN;
  159. VAR
  160.   ADVANCE:-1..1;
  161.  
  162.  
  163. FUNCTION LOCATE (C:CHARACTER; VAR PAT: XSTRING;
  164.   OFFSET:INTEGER):BOOLEAN;
  165. VAR
  166.   I:INTEGER;
  167. BEGIN
  168.   LOCATE:=FALSE;
  169.   I:=OFFSET+PAT[OFFSET];
  170.   WHILE(I>OFFSET) DO
  171.     IF(C=PAT[I]) THEN BEGIN
  172.       LOCATE :=TRUE;
  173.       I:=OFFSET
  174.     END
  175.     ELSE
  176.       I:=I-1
  177. END;BEGIN
  178.   ADVANCE:=-1;
  179.   IF(LIN[I]=ENDSTR) THEN
  180.     OMATCH:=FALSE
  181.   ELSE IF (NOT( PAT[J] IN
  182.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  183.      ERROR('IN OMATCH:CAN''T HAPPEN')
  184.   ELSE
  185.     CASE PAT[J] OF
  186.     LITCHAR:
  187.       IF (LIN[I]=PAT[J+1]) THEN
  188.         ADVANCE:=1;
  189.     BOL:
  190.       IF (I=1) THEN
  191.         ADVANCE:=0;
  192.     ANY:
  193.       IF (LIN[I]<>NEWLINE) THEN
  194.         ADVANCE:=1;
  195.     EOL:
  196.       IF(LIN[I]=NEWLINE) THEN
  197.         ADVANCE:=0;
  198.     CCL:
  199.       IF(LOCATE(LIN[I],PAT,J+1)) THEN
  200.         ADVANCE:=1;
  201.     NCCL:
  202.       IF(LIN[I]<>NEWLINE)
  203.         AND (NOT LOCATE (LIN[I],PAT,J+1)) THEN
  204.           ADVANCE:=1
  205.         END;
  206.     IF(ADVANCE>=0) THEN BEGIN
  207.       I:=I+ADVANCE;
  208.       OMATCH:=TRUE
  209.     END
  210.     ELSE
  211.       OMATCH:=FALSE
  212.   END;
  213.   
  214. FUNCTION PATSIZE(VAR PAT:XSTRING;N:INTEGER):INTEGER;
  215. BEGIN
  216.   IF(NOT (PAT[N] IN
  217.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  218.     ERROR('IN PATSIZE:CAN''T HAPPEN')
  219.   ELSE
  220.     CASE PAT[N] OF
  221.       LITCHAR:PATSIZE:=2;
  222.       BOL,EOL,ANY:PATSIZE:=1;
  223.       CCL,NCCL:PATSIZE:=PAT[N+1]+2;
  224.       CLOSURE:PATSIZE:=CLOSIZE
  225.     END
  226. END;
  227.  
  228. BEGIN
  229.   DONE:=FALSE;
  230.   WHILE(NOT DONE) AND (PAT[J]<>ENDSTR) DO
  231.     IF(PAT[J]=CLOSURE) THEN BEGIN
  232.       J:=J+PATSIZE(PAT,J);
  233.       I:=OFFSET;
  234.       WHILE(NOT DONE) AND (LIN[I]<>ENDSTR) DO
  235.         IF (NOT OMATCH(LIN,I,PAT,J)) THEN
  236.           DONE:=TRUE;
  237.       DONE:=FALSE;
  238.       WHILE (NOT DONE) AND (I>=OFFSET) DO BEGIN
  239.         K:=AMATCH(LIN,I,PAT,J+PATSIZE(PAT,J));
  240.         IF(K>0) THEN
  241.           DONE:=TRUE
  242.         ELSE
  243.           I:=I-1
  244.       END;
  245.       OFFSET:=K;
  246.       DONE:=TRUE
  247.     END
  248.     ELSE IF (NOT OMATCH(LIN,OFFSET,PAT,J))
  249.       THEN BEGIN
  250.       OFFSET :=0;
  251.       DONE:=TRUE
  252.     END
  253.     ELSE
  254.       J:=J+PATSIZE(PAT,J);
  255.   AMATCH:=OFFSET
  256. END;
  257. FUNCTION MATCH;
  258.  
  259. VAR
  260.   I,POS:INTEGER;
  261.  
  262.   
  263.                                                                                
  264. BEGIN
  265.   POS:=0;
  266.   I:=1;
  267.   WHILE(LIN[I]<>ENDSTR) AND (POS=0) DO BEGIN
  268.     POS:=AMATCH(LIN,I,PAT,1);
  269.     I:=I+1
  270.   END;
  271.   MATCH:=(POS>0)
  272. END;
  273.  
  274.  
  275.  
  276.  
  277. PROCEDURE FIND;
  278.   
  279. VAR
  280.   ARG,LIN,PAT:XSTRING;
  281.  
  282. FUNCTION GETPAT(VAR ARG,PAT:XSTRING):BOOLEAN;
  283.  
  284.   
  285.  
  286. BEGIN
  287.   GETPAT:=(MAKEPAT(ARG,1,ENDSTR,PAT)>0)
  288. END;
  289.  
  290.  
  291. BEGIN
  292.   IF(NOT GETARG(2,ARG,MAXSTR))THEN
  293.     ERROR('USAGE:FIND PATTERN');
  294.   IF (NOT GETPAT(ARG,PAT)) THEN
  295.     ERROR('FIND:ILLEGAL PATTERN');
  296.   WHILE(GETLINE(LIN,STDIN,MAXSTR))DO
  297.     IF (MATCH(LIN,PAT))THEN
  298.       PUTSTR(LIN,STDOUT)
  299. END;
  300.  
  301. PROCEDURE CHANGE;
  302. CONST
  303.   DITTO=255;
  304. VAR
  305.   LIN,PAT,SUB,ARG:XSTRING;
  306.  
  307. FUNCTION GETPAT(VAR ARG,PAT:XSTRING):BOOLEAN;
  308.  
  309.   
  310.  
  311. BEGIN
  312.   GETPAT:=(MAKEPAT(ARG,1,ENDSTR,PAT)>0)
  313. END;
  314. FUNCTION GETSUB(VAR ARG,SUB:XSTRING):BOOLEAN;
  315.  
  316. FUNCTION MAKESUB(VAR ARG:XSTRING; FROM:INTEGER;
  317.   DELIM:CHARACTER; VAR SUB:XSTRING):INTEGER;
  318. VAR I,J:INTEGER;
  319.    JUNK:BOOLEAN;
  320. BEGIN
  321.   J:=1;
  322.   I:=FROM;
  323.   WHILE (ARG[I]<>DELIM) AND (ARG[I]<>ENDSTR) DO BEGIN
  324.     IF(ARG[I]=ORD('&')) THEN
  325.       JUNK:=ADDSTR(DITTO,SUB,J,MAXPAT)
  326.     ELSE
  327.       JUNK:=ADDSTR(ESC(ARG,I),SUB,J,MAXPAT);
  328.     I:=I+1
  329.   END;
  330.   IF (ARG[I]<>DELIM) THEN
  331.     MAKESUB:=0
  332.   ELSE IF (NOT ADDSTR(ENDSTR,SUB,J,MAXPAT)) THEN
  333.     MAKESUB:=0
  334.   ELSE
  335.     MAKESUB:=I
  336. END;
  337.  
  338. BEGIN
  339.   GETSUB:=(MAKESUB(ARG,1,ENDSTR,SUB)>0)
  340. END;
  341.  
  342. PROCEDURE SUBLINE(VAR LIN,PAT,SUB:XSTRING);
  343. VAR
  344.   I, LASTM, M:INTEGER;
  345.   JUNK:BOOLEAN;
  346.  
  347.  
  348. PROCEDURE PUTSUB(VAR LIN:XSTRING; S1,S2:INTEGER;
  349.   VAR SUB:XSTRING);
  350. VAR
  351.   I,J:INTEGER;
  352.   JUNK:BOOLEAN;
  353. BEGIN
  354.   I:=1;
  355.   WHILE (SUB[I]<>ENDSTR) DO BEGIN
  356.     IF(SUB[I]=DITTO) THEN
  357.       FOR J:=S1 TO S2-1 DO
  358.         PUTC(LIN[J])
  359.       ELSE
  360.         PUTC(SUB[I]);
  361.       I:=I+1
  362.   END
  363. END;
  364.  
  365. BEGIN
  366.   LASTM:=0;
  367.   I:=1;
  368.   WHILE(LIN[I]<>ENDSTR) DO BEGIN
  369.     M:=AMATCH(LIN,I,PAT,1);
  370.     IF (M>0) AND (LASTM<>M) THEN BEGIN
  371.       PUTSUB(LIN,I,M,SUB);
  372.       LASTM:=M
  373.     END;
  374.     IF (M=0) OR (M=I) THEN BEGIN
  375.       PUTC(LIN[I]);
  376.       I:=I+1
  377.     END
  378.     ELSE
  379.       I:=M
  380.     END
  381. END;
  382.  
  383. BEGIN
  384.   IF(NOT GETARG(2,ARG,MAXSTR)) THEN
  385.     ERROR('USAGE:CHANGE FROM [TO]');
  386.   IF (NOT GETPAT(ARG,PAT)) THEN
  387.     ERROR('CHANGE:ILLEGAL "FROM" PATTERN');
  388.   IF (NOT GETARG(3,ARG,MAXSTR)) THEN
  389.     ARG[1]:=ENDSTR;
  390.   IF(NOT GETSUB(ARG,SUB)) THEN
  391.     ERROR('CHANGE:ILLEGAL "TO" STRING');
  392.   WHILE (GETLINE(LIN,STDIN,MAXSTR)) DO
  393.     SUBLINE(LIN,PAT,SUB)
  394. END;
  395.  
  396. PROCEDURE COMMAND;
  397. VAR I:INTEGER;XS:XSTRING;B:BOOLEAN;
  398.     S:PACKED ARRAY[1..3]OF CHAR;
  399. BEGIN
  400.   B:=GETARG(1,XS,MAXSTR);
  401.   IF (B=TRUE)THEN BEGIN
  402.     for i:=1 to 3 do if islower(xs[i])then s[i]:=chr(xs[i]-32)
  403.     else s[i]:=chr(xs[i]);
  404.   END
  405.   ELSE BDOS(0,0);
  406.   IF (S='CHA')THEN CHANGE
  407.   ELSE IF (S='FIN')THEN FIND
  408. END;
  409.  
  410. BEGIN
  411.   COMMAND;
  412.   ENDCMD;assign(cmdptr,'SHELL.COM');execute(cmdptr)
  413. END.
  414.  
  415.